home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _00c1ddff1449ff02fbdb3e5f70857746 < prev    next >
Encoding:
Text File  |  2002-06-17  |  4.2 KB  |  153 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!perl -w
  14. #line 15
  15.  
  16. use strict;
  17. use ActiveState::RelocateTree qw(relocate spongedir rel2abs);
  18. use Config;
  19. use Getopt::Std;
  20. use vars qw(
  21.     $opt_a $opt_b $opt_d $opt_e $opt_f $opt_i $opt_t $opt_r $opt_v
  22.     *OLDERR
  23. );
  24.  
  25. my $logname;
  26.  
  27. BEGIN {
  28.     # If we're being run via wperl, redirect the output streams to a log file.
  29.     if ($^O eq 'MSWin32' and $^X =~ /\bwperl(.exe)?\z/i) {
  30.     my $tmp = $ENV{TEMP} || $ENV{tmp} || "$ENV{SystemDrive}/" || "c:/temp";
  31.     $logname = "$tmp/ActivePerlInstall.log";
  32.     open(STDERR, ">> $logname");
  33.     open(STDOUT, ">&STDERR");
  34.     }
  35. }
  36.  
  37. my $frompath_default = $Config{prefix};
  38.  
  39. getopts('abde:f:itrv') or usage('');
  40.  
  41. my $topath      = shift || usage('');
  42. my $frompath    = shift || $frompath_default;
  43. # MSI insists on handing us paths with backslashes at the end
  44. if ($^O eq 'MSWin32') {
  45.     $topath =~ s{\\\z}{};
  46.     $frompath =~ s{\\\z}{};
  47. }
  48. my $destpath    = rel2abs($opt_e || $topath);
  49. my $filelist    = $opt_f || '';
  50.  
  51. usage("$destpath is longer than $frompath")
  52.     if length($destpath) > length($frompath) and ! $opt_a;
  53. usage("$destpath is longer than " . spongedir('thisperl'))
  54.     if length($destpath) > length(spongedir('thisperl')) and ! $opt_t;
  55.  
  56. if (-d $topath) {
  57.     if (not -d $frompath) {
  58.     warn "Will do inplace edit of `$topath'\n";
  59.     $opt_i++;
  60.     }
  61. }
  62. elsif ($opt_i) {
  63.     usage("Directory `$topath' doesn't exist, can't do inplace edit");
  64. }
  65.  
  66. sub usage {
  67.     my $msg = shift;
  68.     warn <<EOT;
  69.     $msg
  70.     Usage:
  71.         $0 [-a] [-b] [-d] [-e destpath] [-f logfile] [-i] [-t] [-r] [-v]
  72.            topath [frompath]
  73.  
  74.         -a              allow destpath to be longer than frompath
  75.         -b              don't delete backups after edit
  76.         -d              delete source tree after relocation
  77.         -e destpath     edit files to contain this path instead of `frompath'
  78.                           (defaults to `topath')
  79.         -f logfile      creates `logfile' and writes the full path name of
  80.                           each file that was modified (one line per file)
  81.         -i              edit perl installation at `topath' insitu
  82.                           (makes no attempt to move tree, -d is ignored)
  83.         -t              only edit text files
  84.         -r              do not run `ranlib' on *.a files that were edited
  85.         -v              verbose messages
  86.  
  87.     'destpath' defaults to `topath'
  88.  
  89.     'frompath' defaults to '$frompath_default'
  90.  
  91.     'destpath' must be shorter than 'frompath' unless the -a option is
  92.     specified.
  93.  
  94.     'destpath' must shorter than the path built into this Perl binary,
  95.     unless the -t option is given. The -a switch cannot override this
  96.     restriction.
  97.  
  98.     -i is assumed if `topath' exists, is a directory, and `frompath'
  99.     doesn't exist.
  100. EOT
  101.     exit(1);
  102. }
  103.  
  104. relocate(
  105.     to        => $topath,
  106.     from    => $frompath,
  107.     replace    => $destpath,
  108.     verbose    => $opt_v,
  109.     filelist    => $filelist,
  110.     ranlib    => (not $opt_r),
  111.     textonly    => $opt_t,
  112.     savebaks    => $opt_b,
  113.     inplace    => $opt_i,
  114.     killorig    => $opt_d,
  115. );
  116.  
  117. __END__
  118.  
  119. =head1 NAME
  120.  
  121. reloc_perl - relocate a perl installation
  122.  
  123. =head1 SYNOPSIS
  124.  
  125.   reloc_perl [-a] [-b] [-d] [-e destpath] [-f file] [-i] [-t] [-r] [-v]
  126.              topath [frompath]
  127.  
  128. =head1 DESCRIPTION
  129.  
  130. This tool will move a perl installation wholesale to a new location.
  131.  
  132. Edits path names in binaries (e.g., a2p, perl, libperl.a) to reflect the
  133. new location, but preserves the size of strings by null padding them as
  134. necessary.
  135.  
  136. Edits text files by simple substitution.
  137.  
  138. 'destpath' cannot be longer than 'frompath'.
  139.  
  140. If 'frompath' is not found in any files, no changes whatsoever are made.
  141.  
  142. Running the tool without arguments provides more help.
  143.  
  144. =head1 COPYRIGHT
  145.  
  146. (c) 1999-2001 ActiveState Tool Corp.  All rights reserved.
  147.  
  148. =cut
  149.  
  150.  
  151. __END__
  152. :endofperl
  153.